﻿unit Board;

//(1)
//逻辑棋盘 Logic Chess Board
//标准棋盘方位:红方视角，竖放；
//按经典表现形式，即玩家视图模式，
//红方横坐标从右至左为：一、二、三、四、五、六、七、八、九，黑方横坐标从左至右为1至9
//  棋盘上较短的平行排列的边称为横线。横线共有10条，用红色棋子一方的横线从红方底线算起，从下往上依次用中文数字一至十表示;用黑色棋子一方的横线则从黑方底线开始，依次用阿拉伯数字1-10表示。
//按棋谱表达形式，
//  纵坐标以局面中的棋子的名称及横坐标表示。同列中有相同的棋子时，用前后区分。
//  动作的表示是，任何棋子每走一步，进就写“进”，退就写“退”，如果像车一样横着走，就写“平”。
//  棋谱的动作通常可表示为4字形式，如“车三进7”，“马四进6”。

//计算程序化中，内部逻辑棋盘，横坐标从左至右为0至8,纵坐标从下至上为0至9。
//逻辑棋盘，只有一个标准方位


interface

uses
  Classes, SysUtils,Generics.Collections, Generics.Defaults,Contnrs
  , CommObjU
  , Piece;

const
   cEmpty :AnsiChar ='_'; //空白位用以代表的字符
   cXmax :Integer =8; //标准棋盘方位下，水平方向坐标最大值
   cYmax :Integer =9; //标准棋盘方位下，竖直方向坐标最大值

type
  {
  TPcPos = class
  public
      code :AnsiChar;
      x:byte;
      y:byte;
  end;
  }
  TPcRec = Record
      code :AnsiChar;
      sub  :AnsiChar; //下标(subscript) ,在确定棋子盒中的位置和棋盘中的子的对应关系时才用到，其实对弈中可以不管下标。
  end; //Use for Pieces on Board
  PPcRec = ^TPcRec;

  TPcPos = Record
      code :AnsiChar;
      sub  :AnsiChar; //下标(subscript)
      x:byte;
      y:byte;
  end; //Use for Pieces in Object List;
  PPcPos = ^TPcPos;

  TOvrPts = array[0..8,0..9] of SmallInt;
  TRawPts = array[0..8,0..9] of TPcRec;

  //本类是按数学形式，横坐标为X，从左至右为0至8；纵坐标为Y，从下至上为0至9。
  { TBoard }

  TBoard = class(TObject)
  private

  protected
  public
    points:array[0..8,0..9] of TPcRec;
    nStep :Integer; //2 steps == 1 round.
    BLPos : TPcPos; //黑将位置
    REPos : TPcPos; //红帅位置
    HotPos: TPcPos; //热点位置,最后走子及位置

    qlBcRnum:Integer;  //棋例...黑连捉(将)红步数
    qlBcRLst:TObjectList<TBoard>; //棋例...黑捉(将)红局面列表，自动释放其中的对象
    qlRcBnum:Integer;  //棋例...红连捉(将)黑步数
    qlRcBLst:TObjectList<TBoard>; //棋例...红捉(将)黑局面列表，自动释放其中的对象
    //oScore:TScore; //棋谱类

    PriorBd:TBoard; //用于递归计算中，链接前一局面

    oStaVal:TStaItem; //统计量对象

    constructor Create;
    destructor Destroy; override;
    class procedure clearBoard( bdMe:TBoard );
    class function addPiece( bdMe:TBoard ;const x,y:Byte; const cCode,cSub:AnsiChar):TPcRec;
    //删除棋子,返回位置的原来棋子符号
    class function delPiece( bdMe:TBoard ;const x,y:Byte ):TPcRec;
    class function movePiece( bdMe:TBoard ;const cCode:AnsiChar; const x1,y1:byte; const x2,y2:Byte ):TPcRec;
    class function rollBackPcs( bdMe:TBoard ;const cCode:AnsiChar; const x1,y1:byte; const x2,y2:Byte; PE:TPcRec):Boolean;

    class function toString( bdMe:TBoard):AnsiString;

    //生成标准开局布局
    class procedure initBoardStd( bdMe:TBoard );
    //复制到另一棋盘, 含所有列表
    class procedure copyBoard( atBd:TBoard ; toBd:TBoard );
    //复制到另一棋盘,仅棋子位置
    class procedure copyBoardPts( atBd:TBoard ; toBd:TBoard );
    //黑方捉红方，返回历史重复局面数
    class function searchInBcRlst(lstBd:TBoard;newBd:TBoard):Integer;
    //红方捉黑方，返回历史重复局面数
    class function searchInRcBlst(lstBd:TBoard;newBd:TBoard):Integer;
    class procedure setELPos( bdMe:TBoard );
    class function getCostAtPos(atBd:TBoard; const tX,tY:Byte):Real;
    class function getCostOfPcs(const cPcs:AnsiChar; const tX,tY:Byte):Real;

  end;


implementation

{ TBoard }

constructor TBoard.Create;
begin
  nStep:=0;
  //BLPos := TPicePos.Create;
  //REPos := TPicePos.Create;
    oStaVal:=TStaItem.Create;
    oStaVal.BCatchSum:=0;
    oStaVal.RCatchSum:=0;
end;

destructor TBoard.Destroy;
begin
  if (qlRcBLst<>nil) then
  begin
    qlRcBLst.Clear;
    qlRcBLst.Free;
    qlRcBLst:=nil;
  end;
  if (qlBcRLst<>nil) then
  begin
    qlBcRLst.Clear;
    qlBcRLst.Free;
    qlBcRLst:=nil;
  end;
    oStaVal.Free;
    oStaVal:=nil;
  inherited Destroy;
end;

class function TBoard.getCostAtPos(atBd: TBoard; const tX, tY: Byte): Real;
var cPec: AnsiChar;
begin
    cPec:=atBd.points[tX][tY].code;
    Result:=getCostOfPcs(cPec,tX, tY);
end;

class function TBoard.getCostOfPcs(const cPcs: AnsiChar; const tX,
  tY: Byte): Real;
begin
      //附加价值：
      Result := 0;
        if (cPcs=cRG_Zu) then begin
          if ((tY>4)and(tY<9)) then begin
            Result:=0.5;
          end ;
        end else if (cPcs=cBN_Zu) then begin
          if ((tY>0)and(tY<5)) then begin
            Result:=0.5;
          end ;
        end ;
      //静态价值：
      Result :=Result+ Piece.bID2iCost[Piece.char2ID[ord(cPcs)]];

end;

class procedure TBoard.clearBoard(bdMe: TBoard);
var x,y:Integer;
begin
  for x :=0 to cXmax do begin
  	for y :=0 to cYmax do begin
  		bdMe.points[x][y].code:= cEmpty;
  		bdMe.points[x][y].sub := ' ';
  	end;
  end;
  bdMe.BLPos.code := ' ';
  bdMe.REPos.code := ' ';

end;

class function TBoard.addPiece( bdMe:TBoard ;const x,y:Byte; const cCode,cSub:AnsiChar):TPcRec;
var cRet:TPcRec; //,cSide
begin
  cRet:=bdMe.points[x][y];

  	if (cRet.code=cRE_Jng) then begin
  		bdMe.REPos.code:=cEmpty;
  		bdMe.REPos.sub :=' ';
  	end else if (cRet.code=cBL_Jng) then begin
  		bdMe.BLPos.code:=cEmpty;
  		bdMe.BLPos.sub :=' ';
  	end;


  bdMe.points[x][y].code :=cCode;
  bdMe.points[x][y].sub  :=cSub;

  	if (cCode=cRE_Jng) then begin
  		bdMe.REPos.code:=cCode;
  		bdMe.REPos.sub :=cSub;
  		bdMe.REPos.x := x;
  		bdMe.REPos.y := y;
  	end else if (cCode=cBL_Jng) then begin
  		bdMe.BLPos.code:=cCode;
  		bdMe.BLPos.sub :=cSub;
  		bdMe.BLPos.x := x;
  		bdMe.BLPos.y := y;
  	end;


  Result:= cRet;

end;

class function TBoard.delPiece( bdMe:TBoard ;const x,y:Byte ): TPcRec;
var cRet:TPcRec; //,cSide
begin
  cRet:=bdMe.points[x][y];

  	if (cRet.code=cRE_Jng) then begin
  		bdMe.REPos.code:=cEmpty;
  		bdMe.REPos.sub :=' ';
  	end else if (cRet.code=cBL_Jng) then begin
  		bdMe.BLPos.code:=cEmpty;
  		bdMe.BLPos.sub :=' ';
  	end;


  bdMe.points[x][y].code :=cEmpty;
  bdMe.points[x][y].sub  :=' ';
  Result:= cRet;

end;

class function TBoard.movePiece(bdMe: TBoard; const cCode: AnsiChar; const x1,
  y1: byte; const x2, y2: Byte): TPcRec;
var cRet:TPcRec; // ,cSide
begin
  cRet:=bdMe.points[x2][y2];
	if (cRet.code <> Board.cEmpty) then begin
		if (cRet.code =cRE_Jng) then begin
			bdMe.REPos.code :=cEmpty;
      bdMe.REPos.sub :=' ';
		end else if (cRet.code =cBL_Jng) then begin
			bdMe.BLPos.code :=cEmpty;
      bdMe.BLPos.sub :=' ';
		end ;

	end;
    if (bdMe.points[x1][y1].code<>cCode) then
    begin
      raise Exception.Create('points[x1][y1].code<>cCode');
    end;
	  bdMe.points[x2][y2].code := cCode;
  	bdMe.points[x2][y2].sub  := bdMe.points[x1][y1].sub;
	  bdMe.points[x1][y1].code := Board.cEmpty;
  	bdMe.points[x1][y1].sub :=' ';
		if (cCode =cRE_Jng) then begin
			//bdMe.REPos.code='E';
			bdMe.REPos.x := x2;
			bdMe.REPos.y := y2;
		end else if (cCode =cBL_Jng) then begin
			//bdMe.BLPos.code='L';
			bdMe.BLPos.x := x2;
			bdMe.BLPos.y := y2;
		end;
    bdMe.HotPos.code:=cCode;
    bdMe.HotPos.sub :=bdMe.points[x2][y2].sub;
    bdMe.HotPos.x:=x2;
    bdMe.HotPos.y:=y2;
    Result:= cRet;

end;
class function TBoard.rollBackPcs( bdMe:TBoard ;const cCode:AnsiChar; const x1,y1:byte; const x2,y2:Byte; PE:TPcRec):Boolean;
begin
  Result:=False;
    if (bdMe.points[x1][y1].code<>cEmpty) then
    begin
      Exit;
    end;
    if (bdMe.points[x2][y2].code<>cCode) then
    begin
      Exit;
    end;
    bdMe.points[x1][y1].code:=bdMe.points[x2][y2].code;
    bdMe.points[x1][y1].sub :=bdMe.points[x2][y2].sub;
    bdMe.points[x2][y2].code:=PE.code;
    bdMe.points[x2][y2].sub :=PE.sub;
    //bdMe.HotPos.code:=cCode; 不能恢复HotPos,需预先备份。若要全面恢复，需用 rollBackScore
    //bdMe.HotPos.sub :=bdMe.points[x1][y1].sub;
    //bdMe.HotPos.x:=x1;
    //bdMe.HotPos.y:=y1;
		if (cCode =cRE_Jng) then begin
			bdMe.REPos.x := x1;
			bdMe.REPos.y := y1;
		end else if (cCode =cBL_Jng) then begin
			bdMe.BLPos.x := x1;
			bdMe.BLPos.y := y1;
		end;
    Result:=True;
end;

class function TBoard.searchInBcRlst(lstBd, newBd: TBoard): Integer;
var nRet,nIx,x,y:Integer;
    isSame:Boolean;
    itBd:TBoard;
begin
		nRet := 0;
		isSame:=False;
		if (lstBd.qlBcRLst<>nil) then begin
			for nIx:=0 to lstBd.qlBcRLst.Count-1 do begin
				itBd := lstBd.qlBcRLst[nIx];
				if (itBd <> nil) then begin
					isSame := (Piece.getSide(itBd.HotPos.code) = Piece.getSide(newBd.HotPos.code));
					if (isSame) then begin
						for x:=0 to cXmax do begin
							for y:=0 to cYmax do begin
								if (newBd.points[x][y].code <> itBd.points[x][y].code) then begin
									isSame:=false;
									break;
								end;
							end;
							if (not isSame) then
								break;
						end;
						if ( isSame) then begin
							Inc(nRet);
						end;
					end;
				end;
			end;
		end;
		Result:= nRet;
end;

class function TBoard.searchInRcBlst(lstBd, newBd: TBoard): Integer;
var nRet,nIx,x,y:Integer;
    isSame:Boolean;
    itBd:TBoard;
begin
		nRet := 0;
		isSame:=False;
		if (lstBd.qlRcBLst<>nil) then begin
			for nIx:=0 to lstBd.qlRcBLst.Count-1 do begin
				itBd := lstBd.qlRcBLst[nIx];
				if (itBd <> nil) then begin
					isSame := (Piece.getSide(itBd.HotPos.code) = Piece.getSide(newBd.HotPos.code));
					if (isSame) then begin
						for x:=0 to cXmax do begin
							for y:=0 to cYmax do begin
								if (newBd.points[x][y].code <> itBd.points[x][y].code) then begin
									isSame:=false;
									break;
								end;
							end;
							if (not isSame) then
								break;
						end;
						if ( isSame) then begin
							Inc(nRet);
						end;
					end;
				end;
			end;
		end;
		Result:= nRet;
end;

class procedure TBoard.setELPos(bdMe: TBoard);
var x,y:SmallInt;
begin
  bdMe.REPos.code:=cEmpty;
  bdMe.BLPos.code:=cEmpty;
  for x := 3 to 5 do
  begin
    for y := 0 to 2 do
    begin
      if (bdMe.points[x][y].code=cRE_Jng) then
      begin
        bdMe.REPos.code:=bdMe.points[x][y].code;
        bdMe.REPos.sub :=bdMe.points[x][y].sub;
        bdMe.REPos.x :=x;
        bdMe.REPos.y :=y;
        Break;
      end;

    end;
    if bdMe.REPos.code<>cEmpty then
      Break;
  end;
  for x := 3 to 5 do
  begin
    for y := 7 to 9 do
    begin
      if (bdMe.points[x][y].code=cBL_Jng) then
      begin
        bdMe.BLPos.code:=bdMe.points[x][y].code;
        bdMe.BLPos.sub :=bdMe.points[x][y].sub;
        bdMe.BLPos.x :=x;
        bdMe.BLPos.y :=y;
        Break;
      end;

    end;
    if bdMe.BLPos.code<>cEmpty then
      Break;
  end;

end;

class function TBoard.toString(bdMe: TBoard): AnsiString;
var sL:string;
  x,y:Byte;
begin
  Result:='';
  for y:= cYmax downto 0 do begin
  	sL :='';
    for x:= cXmax downto 0 do begin
  		sL := sL + bdMe.points[x][y].code;
  	end;
  	Result:=Result+sL+#13#10;
  end;
end;

class procedure TBoard.initBoardStd(bdMe: TBoard);
begin
    clearBoard(bdMe);

    addPiece(bdMe,0,0,cRA_Ju,'1');
    addPiece(bdMe,1,0,cRB_Ma,'1');
    addPiece(bdMe,2,0,cRC_Xng,'1');
    addPiece(bdMe,3,0,cRD_Shi,'1');
    addPiece(bdMe,4,0,cRE_Jng,'1');
    addPiece(bdMe,5,0,cRD_Shi,'2');
    addPiece(bdMe,6,0,cRC_Xng,'2');
    addPiece(bdMe,7,0,cRB_Ma,'2');
    addPiece(bdMe,8,0,cRA_Ju,'2');

    addPiece(bdMe,1,2,cRF_Pao,'1');
    addPiece(bdMe,7,2,cRF_Pao,'2');

    addPiece(bdMe,0,3,cRG_Zu,'1');
    addPiece(bdMe,2,3,cRG_Zu,'2');
    addPiece(bdMe,4,3,cRG_Zu,'3');
    addPiece(bdMe,6,3,cRG_Zu,'4');
    addPiece(bdMe,8,3,cRG_Zu,'5');

    addPiece(bdMe,0,9,cBH_Ju,'1');
    addPiece(bdMe,1,9,cBI_Ma,'1');
    addPiece(bdMe,2,9,cBJ_Xng,'1');
    addPiece(bdMe,3,9,cBK_Shi,'1');
    addPiece(bdMe,4,9,cBL_Jng,'1');
    addPiece(bdMe,5,9,cBK_Shi,'2');
    addPiece(bdMe,6,9,cBJ_Xng,'2');
    addPiece(bdMe,7,9,cBI_Ma,'2');
    addPiece(bdMe,8,9,cBH_Ju,'2');

    addPiece(bdMe,1,7,cBM_Pao,'1');
    addPiece(bdMe,7,7,cBM_Pao,'2');

    addPiece(bdMe,0,6,cBN_Zu,'1');
    addPiece(bdMe,2,6,cBN_Zu,'2');
    addPiece(bdMe,4,6,cBN_Zu,'3');
    addPiece(bdMe,6,6,cBN_Zu,'4');
    addPiece(bdMe,8,6,cBN_Zu,'5');

end;

class procedure TBoard.copyBoard(atBd: TBoard; toBd: TBoard);
var n:Integer;
    aBd:TBoard;
begin
  TBoard.copyBoardPts(atBd, toBd);
		if (atBd.qlBcRLst<>nil) then begin
			if (toBd.qlBcRLst=nil) then
				toBd.qlBcRLst := TObjectList<TBoard>.Create(true);
			toBd.qlBcRLst.clear();
			for n:=0 to atBd.qlBcRLst.Count-1 do begin
				aBd := TBoard.Create();
				TBoard.copyBoardPts(atBd.qlBcRLst[n], aBd);
				toBd.qlBcRLst.add(aBd);
			end;
		end;

		if (atBd.qlRcBLst<>nil) then begin
			if (toBd.qlRcBLst=nil) then
				toBd.qlRcBLst := TObjectList<TBoard>.Create(true);
			toBd.qlRcBLst.clear();
			for n:=0 to atBd.qlRcBLst.Count-1 do begin
				aBd := TBoard.Create();
				TBoard.copyBoardPts(atBd.qlRcBLst[n], aBd);
				toBd.qlRcBLst.add(aBd);
			end;
		end;

		toBd.qlBcRnum := atBd.qlBcRnum; //棋例...黑连捉(将)红步数
		toBd.qlRcBnum := atBd.qlBcRnum; //棋例...红连捉(将)黑步数

end;

class procedure TBoard.copyBoardPts(atBd, toBd: TBoard);
var x,y:Integer;
begin
  for x:=0 to cXmax do begin
  	for y:=0 to cYmax do begin
  		toBd.points[x][y].code := atBd.points[x][y].code;
  		toBd.points[x][y].sub  := atBd.points[x][y].sub;
  	end;
  end;
  toBd.BLPos.code := atBd.BLPos.code;
  toBd.BLPos.sub  := atBd.BLPos.sub;
  toBd.BLPos.x := atBd.BLPos.x;
  toBd.BLPos.y := atBd.BLPos.y;
  toBd.REPos.code := atBd.REPos.code;
  toBd.REPos.sub  := atBd.REPos.sub;
  toBd.REPos.x := atBd.REPos.x;
  toBd.REPos.y := atBd.REPos.y;

  toBd.HotPos  := atBd.HotPos;

end;


end.

